﻿Imports Microsoft.VisualBasic
Imports System.Collections.Generic
Imports System.Linq

Public Class Apriori
    Private m_dicTransactions As New Dictionary(Of Integer, String)
    Private m_dicAllFrequentItems As New Dictionary(Of String, Double)
    Private m_noOfTransactionIDs As Integer 'no of OrderIDs
    Private dc As MNLDataContext
    Private dminSupport As Double
    Private dMinConfidence As Double

    Public Sub New(ByVal minSupport As Double, ByVal minConfidence As Double, ByVal partID As Integer)

        dminSupport = minSupport
        dMinConfidence = minConfidence

        dc = New MNLDataContext
        m_dicTransactions = GetTransactions(partID) 'transactionIDs and thier partIDs
    End Sub

    Public Function GenerateCandidates(ByVal dic_FrequentItems As Dictionary(Of String, Double)) As Dictionary(Of String, Double)

        Dim dic_CandidatesReturn As New Dictionary(Of String, Double)
        For i As Integer = 0 To dic_FrequentItems.Count - 1

            Dim strFirstItem As String = SortPartIds(dic_FrequentItems.Keys.ElementAt(i))

            For j As Integer = i + 1 To dic_FrequentItems.Count - 1

                Dim strSecondItem As String = SortPartIds(dic_FrequentItems.Keys.ElementAt(j))
                Dim strGeneratedCandidate As String = GetCandidate(strFirstItem, strSecondItem)

                If strGeneratedCandidate <> "" Then
                    strGeneratedCandidate = SortPartIds(strGeneratedCandidate) 'the candidate {ab, bc}
                    Dim dSupport As Double = GetSupport(strGeneratedCandidate)  'support eg {ab -> 4, cd -> 5}
                    dic_CandidatesReturn.Add(strGeneratedCandidate, dSupport)
                End If
            Next

        Next
        Return dic_CandidatesReturn

    End Function

    'FROM 1

    Public Function GenerateRules() As List(Of clssRules)

        Dim lstRulesReturn As New List(Of clssRules)
        For Each strItem As String In m_dicAllFrequentItems.Keys
            If strItem.Length > 1 Then
                Dim nMaxCombinationLength As Integer = strItem.Length / 2
                GenerateCombination(strItem, nMaxCombinationLength, lstRulesReturn)
            End If
        Next
        Return lstRulesReturn
    End Function

    Private Sub GenerateCombination(ByVal strItem As String, ByVal nCombinationLength As Integer, ByRef lstRulesReturn As List(Of clssRules))
        Dim nItemLength As Integer = strItem.Length

        If nItemLength = 2 Then
            AddItem(strItem(0).ToString, strItem, lstRulesReturn)
            Exit Sub
        ElseIf nItemLength = 3 Then
            For i As Integer = 0 To nItemLength - 1
                AddItem(strItem(i).ToString, strItem, lstRulesReturn)
            Next
            Exit Sub
        Else
            For i As Integer = 0 To nItemLength - 1
                GetCombinationRecursive(strItem(i).ToString(), strItem, nCombinationLength, lstRulesReturn)
            Next
        End If

    End Sub

    Private Function GetCombinationRecursive(ByVal strCombination As String, ByVal strItem As String, _
                                             ByVal nCombinationLength As Integer, ByRef lstRulesReturn As List(Of clssRules)) As String

        AddItem(strCombination, strItem, lstRulesReturn)
        Dim cLastTokenCharacter As Char = strCombination(strCombination.Length - 1)
        Dim nLastTokenCharcaterIndex As Integer = strCombination.IndexOf(cLastTokenCharacter)
        Dim nLastTokenCharcaterIndexInParent As Integer = strItem.IndexOf(cLastTokenCharacter)
        Dim cNextCharacter As Char
        Dim cLastItemCharacter As Char = strItem(strItem.Length - 1)

        If strCombination.Length = nCombinationLength Then

            If (cLastTokenCharacter <> cLastItemCharacter) Then
                strCombination = strCombination.Remove(nLastTokenCharcaterIndex, 1)
                cNextCharacter = strItem(nLastTokenCharcaterIndexInParent + 1)
                Dim strNewToken As String = strCombination + cNextCharacter
                Return GetCombinationRecursive(strNewToken, strItem, nCombinationLength, lstRulesReturn)

            Else
                Return ""
            End If
        Else
            If strCombination <> cLastItemCharacter.ToString Then
                cNextCharacter = strItem(nLastTokenCharcaterIndex + 1)
                Dim strNewToken As String = strCombination + cNextCharacter
                Return GetCombinationRecursive(strNewToken, strItem, nCombinationLength, lstRulesReturn)
            Else
                Return String.Empty
            End If
        End If

    End Function
    Private Sub AddItem(ByVal strCombination As String, ByVal strItem As String, ByRef lstRulesReturn As List(Of clssRules))

        Dim strRemaining As String = GetRemaining(strCombination, strItem)

        Dim Rule As New clssRules(strCombination, strRemaining, 0)
        lstRulesReturn.Add(Rule)
    End Sub

    Private Function GetRemaining(ByVal strChild As String, ByVal strParent As String) As String

        For i As Integer = 0 To strChild.Length - 1
            Dim nIndex As Integer = strParent.IndexOf(strChild(i))
            strParent = strParent.Remove(nIndex, 1)
        Next

        Return strParent
    End Function

    Public Function GetStrongRules(ByVal dMinConfidenceas As Double, ByVal lstRules As List(Of clssRules)) As List(Of clssRules)

        Dim lstStrongRulesReturn As New List(Of clssRules)

        For Each Rule As clssRules In lstRules
            Dim strXY As String = SortPartIds(Rule.X + Rule.Y)
            AddStrongRule(Rule, strXY, lstStrongRulesReturn, dMinConfidence)
        Next

        lstStrongRulesReturn.Sort()
        Return lstStrongRulesReturn

    End Function

    Private Sub AddStrongRule(ByVal Rule As clssRules, ByVal strXY As String, ByRef lstStrongRulesReturn As List(Of clssRules), ByVal dMinConfidence As Double)
        Dim dConfidence As Double = GetConfidence(Rule.X, strXY)
        Dim NewRule As clssRules

        If (dConfidence >= dMinConfidence) Then
            NewRule = New clssRules(Rule.X, Rule.Y, dConfidence)
            lstStrongRulesReturn.Add(NewRule)
        End If
        dConfidence = GetConfidence(Rule.Y, strXY)

        If (dConfidence >= dMinConfidence) Then
            NewRule = New clssRules(Rule.Y, Rule.X, dConfidence)
            lstStrongRulesReturn.Add(NewRule)
        End If
    End Sub

    Private Function GetConfidence(ByVal strX As String, ByVal strXY As String) As Double
        Dim dSupport_X As Double
        Dim dSupport_XY As Double
        dSupport_X = m_dicAllFrequentItems(strX)
        dSupport_XY = m_dicAllFrequentItems(strXY)
        Return dSupport_XY / dSupport_X

    End Function

    'END 1

    'FROM 

    Public Function GetClosedItemSets() As Dictionary(Of String, Dictionary(Of String, Double))

        Dim dicClosedItemSetsReturn As New Dictionary(Of String, Dictionary(Of String, Double))
        Dim dicParents As Dictionary(Of String, Double)

        For i As Integer = 0 To m_dicAllFrequentItems.Count - 1
            Dim strChild As String = m_dicAllFrequentItems.Keys.ElementAt(i)
            dicParents = GetItemParents(strChild, i + 1)
            If IsClosed(strChild, dicParents) Then
                dicClosedItemSetsReturn.Add(strChild, dicParents)
            End If
        Next
        Return dicClosedItemSetsReturn
    End Function

    Private Function GetItemParents(ByVal strChild As String, ByVal nIndex As Integer) As Dictionary(Of String, Double)
        Dim dicParents As New Dictionary(Of String, Double)

        For j As Integer = nIndex To m_dicAllFrequentItems.Count - 1

            Dim strParent As String = m_dicAllFrequentItems.Keys.ElementAt(j)
            If strParent.Length = strChild.Length + 1 Then
                If IsSubstring(strChild, strParent) Then
                    dicParents.Add(strParent, m_dicAllFrequentItems(strParent))

                End If
            End If
        Next
        Return dicParents
    End Function

    Private Function IsClosed(ByVal strChild As String, ByVal dicParents As Dictionary(Of String, Double)) As Boolean

        For Each strParent As String In dicParents.Keys
            If m_dicAllFrequentItems(strChild) = m_dicAllFrequentItems(strParent) Then
                Return False
            End If
        Next
        Return True
    End Function

    Public Function GetFrequentItems(ByVal dic_Candidates As Dictionary(Of String, Double), ByVal dMinSupport As Double) As Dictionary(Of String, Double)

        Dim dic_FrequentReturn As New Dictionary(Of String, Double)

        Dim i As Integer = dic_Candidates.Count - 1

        While i >= 0
            Dim strItem As String = dic_Candidates.Keys.ElementAt(i)
            Dim dSupport As Double = dic_Candidates(strItem)

            If ((dSupport / CType(m_noOfTransactionIDs, Double)) >= dMinSupport) Then

                dic_FrequentReturn.Add(strItem, dSupport)
                m_dicAllFrequentItems.Add(strItem, dSupport)

            End If

            i = i - 1
        End While

        Return dic_FrequentReturn
    End Function

    'END

    'get the support S of each 1-itemset,
    Public Function GetL1FrequentItems() As Dictionary(Of String, Double)

        Dim dic_FrequentItemsReturn As New Dictionary(Of String, Double)

        Dim transactionEnumerator = m_dicTransactions.GetEnumerator

        Dim partIDs As New List(Of String)
        While transactionEnumerator.MoveNext

            Dim currPartIDsArray As String = transactionEnumerator.Current.Value.ToArray

            For Each c As Char In currPartIDsArray

                If Not partIDs.Contains(c) Then
                    partIDs.Add(c)
                End If
            Next
        End While
        'we now have all partIDs that have been ordered with the part in view
        'iterate to get the support of each part ID
        'support --the number of times a particular partID appears in the transaction set retrieved
        For Each p In partIDs
            Dim dSupport As Double = GetSupport(p)

            If ((dSupport / CType(m_noOfTransactionIDs, Double)) >= dminSupport) Then
                dic_FrequentItemsReturn.Add(p, dSupport)
                m_dicAllFrequentItems.Add(p, dSupport)
            End If
        Next
        Return dic_FrequentItemsReturn
    End Function

    Private Function GetSupport(ByVal strGeneratedCandidate As String) As Double
        Dim dSupportReturn As Double = 0
        For Each strTransaction As String In m_dicTransactions.Values
            If IsSubstring(strGeneratedCandidate, strTransaction) Then
                dSupportReturn = dSupportReturn + 1
            End If

        Next
        Return dSupportReturn
    End Function

    'get all previous transactions containing the part being viewed by the customer
    Private Function GetTransactions(ByVal dPartID As Integer) As Dictionary(Of Integer, String)
        Dim rtn As New Dictionary(Of Integer, String)

        'get OrderIDs
        Dim orderIDs = (From o In dc.OrderItems Where o.PartID = dPartID Select o.OrderID) ' all orderids containing the part being viewed
        If orderIDs.Count > 0 Then
            orderIDs = orderIDs.Distinct
            m_noOfTransactionIDs = orderIDs.Count
        End If

        'get all partIds of each OrderID
        For Each i As Integer In orderIDs
            Dim oi As Integer = i
            Dim partIDs = (From o In dc.OrderItems Where o.OrderID = oi Select o.PartID).ToList

            Dim sb As New StringBuilder
            'Dim cnt As Integer = 0
            For Each partID In partIDs
                'cnt = cnt + 1
                sb.Append(partID)
                'If cnt <> partIDs.Count Then
                '    sb.Append(",")
                'End If
            Next

            rtn.Add(oi, sb.ToString)
        Next

        Return rtn
    End Function

    Private Function GetCandidate(ByVal strFirstItem As String, ByVal strSecondItem As String) As String
        Dim nLength As Integer = strFirstItem.Length
        If nLength = 1 Then
            Return strFirstItem + strSecondItem
        Else
            Dim strFirstSubString As String = strFirstItem.Substring(0, nLength - 1)
            Dim strSecondSubString As String = strSecondItem.Substring(0, nLength - 1)

            If strFirstSubString = strSecondSubString Then
                Return strFirstItem + strSecondItem(nLength - 1)
            Else
                Return String.Empty
            End If
        End If

    End Function

    Private Function SortPartIds(ByVal strToken As String) As String
        'Convert to char array, then sort and return
        Dim arrToken() As Char = strToken.ToArray()
        Array.Sort(arrToken)
        Return New String(arrToken)
    End Function

    Private Function IsSubstring(ByVal strChild As String, ByVal strParent As String) As Boolean
        For Each c As Char In strChild
            If Not strParent.Contains(c) Then
                Return False
            End If
        Next
        Return True
    End Function
End Class

Public Class clssRules
    Implements IComparable(Of clssRules)

    Private _strCombination As String
    Private _strRemaining As String
    Private _confidence As Double

    Public Sub New(ByVal strCombination As String, ByVal strRemaining As String, ByVal confidence As Double)
        _strCombination = strCombination
        _strRemaining = strRemaining
        _confidence = confidence
    End Sub

    Public ReadOnly Property X As String
        Get
            Return _strCombination
        End Get
    End Property
    Public ReadOnly Property Y As String
        Get
            Return _strRemaining
        End Get
    End Property
    Public ReadOnly Property Confidence As String
        Get
            Return _confidence
        End Get
    End Property
    Public Function CompareTo(ByVal other As clssRules) As Integer Implements System.IComparable(Of clssRules).CompareTo

        Return X.CompareTo(other.X)
    End Function
End Class

